original function set

load(resfile_orig[1])
nn_mod <- torch_load(modfile_orig[1])
plot_datagen_fcns(sim_res$sim_params$flist)

2 hidden layers, 16-8

  • uncorrected KL, without Kaiming initialization, \(\tau_0 = 1\)

sim 1

loss_pltfcn(sim_res, burn = 2e4)$mse_plt

loss_pltfcn(sim_res, burn = 2e4)$kl_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 25e4
)$all_vars_plt

kmat_global <- kappamat_from_sim_res(sim_res)
kmat_local <- kappamat_from_sim_res(sim_res, type = "local")
varmat_pltfcn(
  kmat_global,
  y_name = "GLOBAL kappa",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  kmat_local,
  y_name = "LOCAL kappa",
  burn = 0
)$all_vars_plt

if (!is.null(sim_res$kappa_tc_mat)){
  # didn't add tau-corrected kappas to sims until later
  varmat_pltfcn(
    sim_res$kappa_tc_mat,
    y_name = "tau-corrected kappas",
    burn = 0
  )$all_vars_plt
}


err_by_max_bfdr(kmat_local[nrow(kmat_local), ])$plt_fdrs + 
  labs(
    subtitle = "using local kappas as dropout probabilities"
  )

err_by_max_bfdr(kmat_global[nrow(kmat_global), ])$plt_fdrs + 
  labs(
    subtitle = "using global kappas as dropout probabilities"
  )

err_by_max_bfdr(get_kappas_taucorrected(nn_mod))$plt_fdrs + 
  labs(
    subtitle = "tau-corrected kappas as dropout probabilities"
  )

sim 2

load(resfile_orig[2])
nn_mod <- torch_load(modfile_orig[2])
loss_pltfcn(sim_res, burn = 2e4)$mse_plt

loss_pltfcn(sim_res, burn = 2e4)$kl_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 25e4
)$all_vars_plt

kmat_global <- kappamat_from_sim_res(sim_res)
kmat_local <- kappamat_from_sim_res(sim_res, type = "local")
varmat_pltfcn(
  kmat_global,
  y_name = "GLOBAL kappa",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  kmat_local,
  y_name = "LOCAL kappa",
  burn = 0
)$all_vars_plt

if (!is.null(sim_res$kappa_tc_mat)){
  # didn't add tau-corrected kappas to sims until later
  varmat_pltfcn(
    sim_res$kappa_tc_mat,
    y_name = "tau-corrected kappas",
    burn = 0
  )$all_vars_plt
}


err_by_max_bfdr(kmat_local[nrow(kmat_local), ])$plt_fdrs + 
  labs(
    subtitle = "using local kappas as dropout probabilities"
  )

err_by_max_bfdr(kmat_global[nrow(kmat_global), ])$plt_fdrs + 
  labs(
    subtitle = "using global kappas as dropout probabilities"
  )

err_by_max_bfdr(get_kappas_taucorrected(nn_mod))$plt_fdrs + 
  labs(
    subtitle = "tau-corrected kappas as dropout probabilities"
  )

sim 3

load(resfile_orig[3])
nn_mod <- torch_load(modfile_orig[3])
loss_pltfcn(sim_res, burn = 2e4)$mse_plt

loss_pltfcn(sim_res, burn = 2e4)$kl_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 25e4
)$all_vars_plt

kmat_global <- kappamat_from_sim_res(sim_res)
kmat_local <- kappamat_from_sim_res(sim_res, type = "local")
varmat_pltfcn(
  kmat_global,
  y_name = "GLOBAL kappa",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  kmat_local,
  y_name = "LOCAL kappa",
  burn = 0
)$all_vars_plt

if (!is.null(sim_res$kappa_tc_mat)){
  # didn't add tau-corrected kappas to sims until later
  varmat_pltfcn(
    sim_res$kappa_tc_mat,
    y_name = "tau-corrected kappas",
    burn = 0
  )$all_vars_plt
}


err_by_max_bfdr(kmat_local[nrow(kmat_local), ])$plt_fdrs + 
  labs(
    subtitle = "using local kappas as dropout probabilities"
  )

err_by_max_bfdr(kmat_global[nrow(kmat_global), ])$plt_fdrs + 
  labs(
    subtitle = "using global kappas as dropout probabilities"
  )

err_by_max_bfdr(get_kappas_taucorrected(nn_mod))$plt_fdrs + 
  labs(
    subtitle = "tau-corrected kappas as dropout probabilities"
  )

sim 4

load(resfile_orig[4])
nn_mod <- torch_load(modfile_orig[4])
loss_pltfcn(sim_res, burn = 2e4)$mse_plt

loss_pltfcn(sim_res, burn = 2e4)$kl_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 25e4
)$all_vars_plt

kmat_global <- kappamat_from_sim_res(sim_res)
kmat_local <- kappamat_from_sim_res(sim_res, type = "local")
varmat_pltfcn(
  kmat_global,
  y_name = "GLOBAL kappa",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  kmat_local,
  y_name = "LOCAL kappa",
  burn = 0
)$all_vars_plt

if (!is.null(sim_res$kappa_tc_mat)){
  # didn't add tau-corrected kappas to sims until later
  varmat_pltfcn(
    sim_res$kappa_tc_mat,
    y_name = "tau-corrected kappas",
    burn = 0
  )$all_vars_plt
}


err_by_max_bfdr(kmat_local[nrow(kmat_local), ])$plt_fdrs + 
  labs(
    subtitle = "using local kappas as dropout probabilities"
  )

err_by_max_bfdr(kmat_global[nrow(kmat_global), ])$plt_fdrs + 
  labs(
    subtitle = "using global kappas as dropout probabilities"
  )

err_by_max_bfdr(get_kappas_taucorrected(nn_mod))$plt_fdrs + 
  labs(
    subtitle = "tau-corrected kappas as dropout probabilities"
  )

sim 5

load(resfile_orig[5])
nn_mod <- torch_load(modfile_orig[5])
loss_pltfcn(sim_res, burn = 2e4)$mse_plt

loss_pltfcn(sim_res, burn = 2e4)$kl_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  sim_res$alpha_mat,
  y_name = "alpha",
  burn = 25e4
)$all_vars_plt

kmat_global <- kappamat_from_sim_res(sim_res)
kmat_local <- kappamat_from_sim_res(sim_res, type = "local")
varmat_pltfcn(
  kmat_global,
  y_name = "GLOBAL kappa",
  burn = 0
)$all_vars_plt

varmat_pltfcn(
  kmat_local,
  y_name = "LOCAL kappa",
  burn = 0
)$all_vars_plt

if (!is.null(sim_res$kappa_tc_mat)){
  # didn't add tau-corrected kappas to sims until later
  varmat_pltfcn(
    sim_res$kappa_tc_mat,
    y_name = "tau-corrected kappas",
    burn = 0
  )$all_vars_plt
}


err_by_max_bfdr(kmat_local[nrow(kmat_local), ])$plt_fdrs + 
  labs(
    subtitle = "using local kappas as dropout probabilities"
  )

err_by_max_bfdr(kmat_global[nrow(kmat_global), ])$plt_fdrs + 
  labs(
    subtitle = "using global kappas as dropout probabilities"
  )

err_by_max_bfdr(get_kappas_taucorrected(nn_mod))$plt_fdrs + 
  labs(
    subtitle = "tau-corrected kappas as dropout probabilities"
  )

smoother function set - 10k obs

  • other changes: corrected KL, Kaiming initialization, calibrated \(\tau_0\) re: Piironen & Vehtari 2017 to assume 1/2 covaraiates are nuisance.
img_suffixes <- c(paste0("_e", 1:9, "e_+05.png"), "_e1e_+06.png")

stem_pvtau1 <- here::here("sims", "results", "hshoe_smooth_pvtau_1721632_12500obs_")
stem_pvtau2 <- here::here("sims", "results", "hshoe_smooth_pvtau_2721632_12500obs_")
seed_pvtau2 <- c(19709, 809872, 264744, 498729, 336130, 263808, 877164, 218489, 234821, 616240)
seed_pvtau1 <- c(561114, 453639, 663173, 108703, 165780)

resfile_pvtau1 <- paste0(stem_pvtau1, seed_pvtau1, ".RData")
modfile_pvtau1 <- paste0(stem_pvtau1, seed_pvtau1, ".pt")

resfile_pvtau2 <- paste0(stem_pvtau2, seed_pvtau2, ".RData")
modfile_pvtau2 <- paste0(stem_pvtau2, seed_pvtau2, ".pt")
load(resfile_pvtau1[1])
nn_mod <- torch_load(modfile_pvtau1[1])
plot_datagen_fcns(sim_res$sim_params$flist)

1M epochs

sim 1

sim 2

sim 3

sim 4

sim 5

500k epochs

sim 1

sim 2

sim 3

sim 4

sim 5

sim 6

sim 7

sim 8

sim 9

sim 10

smoother function set - 1k obs

stem_1k_1632 <- here::here("sims", "results", "hshoe_pvtau10_correctedkappas_216321250obs_")
stem_1k_816 <- here::here("sims", "results", "hshoe_pvtau10_correctedkappas_8161250obs_")

seed_1k <- c(215244, 272835, 124107, 782699, 798186)

resfile_1k_1632 <- paste0(stem_1k_1632, seed_1k, ".RData")
modfile_1k_1632 <- paste0(stem_1k_1632, seed_1k, ".pt")

resfile_1k_816 <- paste0(stem_1k_816, seed_1k, ".RData")
modfile_1k_816 <- paste0(stem_1k_816, seed_1k, ".pt")
load(resfile_1k_1632[1])
plot_datagen_fcns(sim_res$sim_params$flist)

hidden layer dim: 16-32

sim 1

sim 2

sim 3

sim 4

sim 5

hidden layer dim: 8-16

sim 1

sim 2

sim 3

sim 4

sim 5